home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / UNITS / PBSCRN.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-03  |  7KB  |  263 lines
  1. UNIT PbSCRN;
  2.  
  3. INTERFACE
  4.  
  5. uses PbMISC, PbOBJS, PbDDL;
  6.  
  7. {
  8. Description : Decodes the screen.CRT file and updates the DDL
  9.  
  10. Author      : Howard Richoux
  11. Date        : 2/6/94
  12. Last revised: 2/18/94 NEW LIBRARIES
  13. Application : IBM PC and compatibles, done in Turbo Pascal 7
  14. Status      : Placed in the Public Domain by HNR Software 1/94
  15. Published in: none
  16. }
  17.  
  18.  
  19. var flds       : DDL_object;   { hold list of fields/lengths (if needed) }
  20. var UsesStr    : string;     { slipped into the USES statement }
  21.  
  22.  
  23. var txt        : STRA_object;  { 200 lines }
  24.     image      : STRA_object;  { 25 lines - screen picture only }
  25.     literals   : stra_object;  { 25 lines - screen/no data image }
  26.     vars       : STRA_object;  { 50 lines - whole VAR lines }
  27.     fields     : STRA_object;  { 50 lines - from var lines }
  28.  
  29. var DeclareData : boolean;     { tells SCRNGEN to declare the data variables }
  30.  
  31. var scrnwidth  : byte;
  32.     scrnlength : byte;
  33.     scrntoplabl : string[40];
  34.     scrnbotlabl : string[40];
  35.  
  36.  
  37. Procedure ProcessCRTFile(fn,sect : string; var flds : DDL_object);
  38.  
  39.  
  40.  
  41. {SECTION .ZIMPLEMENTATION }
  42. IMPLEMENTATION
  43.  
  44.  
  45. Procedure RemoveStuffFromString( stuff : string; var str : string);
  46. var s : string;
  47.     i : integer;
  48.      begin
  49.      i := 1;
  50.      s := str;
  51.      i := pos(stuff,s);
  52.      while i > 0 do
  53.           begin
  54.           i := pos(stuff,s);
  55.           if i > 0 then delete(s,i,length(stuff));
  56.           end;
  57.      str := s;
  58.      end;
  59.  
  60.  
  61. Function ExtractLabelStr( str : string) : string;
  62. var s : string;
  63.      begin
  64.      s := str;
  65.      {peel off the "|---...--"  and "----...--|"   whats left is the label}
  66.      RemoveStuffFromString('--',s);
  67.      RemoveStuffFromString('|-',s);
  68.      RemoveStuffFromString('-|',s);
  69.      RemoveStuffFromString('|',s);
  70.      ExtractLabelStr := s;
  71.      end;
  72.  
  73.  
  74. Procedure ProcessVARline(str : string);
  75. var s,s1,v,nam,opt : string;
  76.     i          : integer;
  77.     typ        : char;
  78.     l,len,decp : byte;
  79.      begin
  80.      s := str;
  81.      delete(s,1,3);
  82.      RemoveLeading(s,' ');
  83.      vars.append(s);
  84.      nam := GetLeftStr(s,':');
  85.      nam := UpCaseStr(nam);
  86.      trim(nam);
  87.      fields.append(nam);
  88.      opt := ExtractDelimitedStr(s,'{','}');
  89.      v := s;
  90.      v := UpCaseStr(v);
  91.      RemoveStuffFromString(';',v);
  92.      RemoveStuffFromString(' ',v);
  93.      if length(v) > 0 then
  94.           begin
  95.           decp := 0;
  96.           typ := v[1];
  97.           case typ of
  98.                'I'   : begin
  99.                        len := 2;
  100.                        l   := 6;
  101.                        end;
  102.                'L'   : begin
  103.                        len := 4;
  104.                        l   := 8;
  105.                        end;
  106.                'R'   : begin
  107.                        len := 4;
  108.                        l   := 10;
  109.                        end;
  110.                'S'   : begin
  111.                        s1 := GetDelimitedStr(v,'[',']');
  112.                        len := strint(s1);
  113.                        l   := len;
  114.                        end;
  115.                 else   begin
  116.                        end;
  117.                 end;
  118.           end;
  119.  
  120.      i := flds.find(nam);
  121.      if i = 0 then
  122.           begin
  123.           flds.append(nam,typ,len,decp);
  124.           end;
  125.      i := flds.find(nam);
  126.      if i > 0 then flds.ddl[i].options := opt;
  127.      end;
  128.  
  129.  
  130. Procedure ProcessOPTIONline(str : string);
  131. var s, opt, value : string;
  132.      begin
  133.      s := str;
  134.      UpCaseStr(s);
  135.      opt := GetLeftStr(s,'=');
  136.      trim(opt);
  137.      value := s; trim(value);
  138.      if (opt='DECLARE') and (value='YES') then DeclareData := true;
  139.      if (opt='USES') then UsesStr := ', '+value;
  140.      end;
  141.  
  142.  
  143. Procedure LoadScreenDef;
  144. var i,j   : integer;
  145.     done  : boolean;
  146.     s,s1  : string;
  147.      begin
  148.      done := false;
  149.      scrnwidth  := 0;
  150.      scrnlength := 0;
  151.      scrntoplabl := '';
  152.      scrnbotlabl := '';
  153.      i := 0;
  154.      while (i < txt.count) and not done do
  155.           begin
  156.           inc(i);
  157.           s := txt.fetchN(i);
  158.           trim(s);
  159.           if (s[1] = '|') and (s[length(s)] = '|') then
  160.                begin
  161.                image.append(s);
  162.                scrnwidth := length(s);
  163.                s1 := s;
  164.                delete(s1,1,1);delete(s1,length(s1),1);
  165.                patchstr(s1,'_',' ');
  166.                RemoveTrailing(s1,' ');
  167.                literals.append(s1);
  168.                inc(scrnlength);
  169.                end
  170.           else if CompareUpL(s,'VAR',3) then
  171.                begin
  172.                ProcessVARline(s);
  173.                end
  174.           else begin
  175.                j := pos('=',s);
  176.                if j > 0 then ProcessOptionLine(s);
  177.                end;
  178.           end;
  179.      if (scrnwidth  < 3)  then scrnwidth  := 3;
  180.      if (scrnwidth  > 80) then scrnwidth  := 80;
  181.      if (scrnlength > 25) then scrnlength := 25;
  182.      if (scrnlength < 3)  then scrnlength := 3;
  183.      s := image.fetchN(1);
  184.      scrntoplabl := ExtractLabelStr(s);
  185.      s := image.fetchN(image.count);
  186.      scrnbotlabl := ExtractLabelStr(s);
  187.      end;
  188.  
  189.  
  190. Procedure UpdateDDLs(fnam : string; fldrow,fldcol,fldln : byte);
  191. var i : integer;
  192.      begin
  193.      i := flds.find(fnam);
  194.      if i > 0 then
  195.           begin
  196.           flds.ddl[i].r := fldrow;
  197.           flds.ddl[i].c := fldcol;
  198.           flds.ddl[i].l := fldln;
  199.           end;
  200.      end;
  201.  
  202.  
  203. Procedure MatchNamesAndFields;
  204. var i,j,k,fnum : integer;
  205.     r,c,ln : byte;
  206.     done   : boolean;
  207.     s,nam  : string;
  208.      begin
  209.      vars.dump;
  210.      fnum := 1;
  211.      done := false;
  212.      k := 1;
  213.      while (k < image.count) and not done do
  214.           begin
  215.           inc(k);
  216.           s := image.fetchN(k);
  217.           trim(s);
  218.           s := RemoveBrackets(s);
  219.           j := pos('_',s);
  220.           while (j > 0) do
  221.                begin
  222.                c := j; r := k; ln := 1;
  223.                while s[j] = '_' do
  224.                     begin
  225.                     s[j] := '~';
  226.                     ln := j - c;
  227.                     inc(j);
  228.                     end;
  229.                UpdateDDLs(fields.fetchN(fnum),r-1,c-1,ln+1);
  230.                inc(fnum);
  231.                j := pos('_',s);
  232.                end;
  233.           end;
  234.      end;
  235.  
  236.  
  237.  
  238.  
  239. Procedure ProcessCRTFile(fn,sect : string; var flds : DDL_object);
  240.      begin
  241.      txt.loadsection(fn,'{SECTION',sect);
  242.      LoadScreenDef;
  243.      MatchNamesAndFields;
  244.      end;
  245.  
  246.  
  247.  
  248.  
  249.  
  250. {SECTION  ZInitialization }
  251.      begin {Initialization}
  252.      scrnwidth   := 0;
  253.      scrnlength  := 0;
  254.      scrntoplabl := '';
  255.      scrnbotlabl := '';
  256.      txt.init     (200);
  257.      image.init    (25);
  258.      literals.init (25);
  259.      vars.init     (50);
  260.      fields.init   (50);
  261.      declaredata := false;
  262.      end.
  263.